home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / MAPSML.for < prev    next >
Text File  |  1991-05-22  |  9KB  |  298 lines
  1.         SUBROUTINE MAPSML(XLOW,XHIGH,YLOW,YHIGH,XLAB,YLAB,TITLE,IAXES)
  2. C
  3. C       Cut down version of MAPIT for those users who only need MAPIT to do
  4. C       simple things.
  5. C
  6. C       The following options have been commented out:
  7. C
  8. C       OPTION          COMMENT CHARS           ADDED LINE CMNT CHARS
  9. C       ------          -------------           ---------------------
  10. C       GRID LINES              CC                      !!
  11. C       LOG AXES                CCC                     !!!
  12. C       BOXED PLOT              CCCC                    !!!!
  13. C
  14. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  15. C
  16.     IMPLICIT NONE
  17.     REAL*4 XLOW,XHIGH,YLOW,YHIGH
  18.     INTEGER IAXES
  19.         INCLUDE DIGLIB$KOM:PLTCOM.PRM
  20.         INCLUDE DIGLIB$KOM:PLTSIZ.PRM
  21.         INCLUDE DIGLIB$KOM:PLTCLP.PRM
  22.         INCLUDE DIGLIB$KOM:PLTPRM.PRM
  23. C
  24.         EXTERNAL LEN
  25.     INTEGER LEN
  26.     INTEGER NUMTK,MXLAB,N,IYPWR,ILABSZ,IXPWR
  27.     REAL*4 XTMIN,YTMIN,TENEXP,X,TICKSP,TCKSGN,VX,VY,Y
  28.     REAL*4 YTICK,XTICK,XTMAX,YTMAX,LN
  29.         CHARACTER*1 XLAB(2), YLAB(2), TITLE(2)
  30.         CHARACTER*1 NUMBR(14)
  31.         LOGICAL*1 LOGXX, LOGYY, LRMTEX, LSHORT, LRAGGD
  32.     INTEGER*1 IAND
  33. CCC     LOGICAL*1 LOGT
  34. CCC     DIMENSION ZLOG(8)
  35. C
  36. CCC     DATA ZLOG /0.3010, 0.4771, 0.6021, 0.6990, 0.7782, 0.8451,
  37. CCC     1   0.9031, 0.9542 /
  38. CCC     DATA TMINLD /0.1/       !MINIMUM DISTANCE BETWEEN SHORT TICKS (1 MM)
  39. CCC     DATA SHORTF /2.0/       !SHORT TICKS = TICKLN/SHORTF
  40. C
  41. C
  42. C       SET LOGX AND LOGY TO FALSE FOR OUR USAGE OF SCALE
  43. C
  44.         LOGX = .FALSE.
  45.         LOGY = .FALSE.
  46. C
  47. C       SEE WHAT TYPE OF AXES ARE DESIRED
  48. C
  49. CCC     LOGXX = IAND(IAXES,1) .NE. 0
  50. CCC     LOGYY = IAND(IAXES,2) .NE. 0
  51.         LRAGGD = IAND(IAXES,256) .NE. 0
  52. C
  53. C       DO THE AXES SCALING
  54. C
  55.         NUMTK = MIN0(10,INT(XVLEN/((ILABSZ()+1.0)*CXSIZE)))
  56. CCC     IF (LOGXX) GO TO 20
  57.         LSHORT = IAND(IAXES,16) .NE. 0
  58.         CALL AXIS(XLOW,XHIGH,NUMTK,LSHORT,LRAGGD,XMIN,XMAX,XTMIN,XTMAX,
  59.      1   XTICK,IXPWR)
  60. CCC     GO TO 40
  61. CCC20   CALL LAXIS(XLOW,XHIGH,NUMTK,XMIN,XMAX,XTICK)
  62. CCC     XTMIN = XMIN
  63. CCC     XTMAX = XMAX
  64. CCC     IXPWR = 0
  65. CCC40   CONTINUE
  66.         NUMTK = MIN0(10,INT(YVLEN/(3.0*CYSIZE)))
  67. CCC     IF (LOGYY) GO TO 60
  68.         LSHORT = IAND(IAXES,32) .NE. 0
  69.         CALL AXIS(YLOW,YHIGH,NUMTK,LSHORT,LRAGGD,YMIN,YMAX,YTMIN,YTMAX,
  70.      1   YTICK,IYPWR)
  71. CCC     GO TO 80
  72. CCC60   CALL LAXIS(YLOW,YHIGH,NUMTK,YMIN,YMAX,YTICK)
  73. CCC     YTMIN = YMIN
  74. CCC     YTMAX = YMAX
  75. CCC     IYPWR = 0
  76. CCC80   CONTINUE
  77. C
  78. C       SET UP TEMPORARY SCALING FACTORS
  79. C
  80.         UX0 = XMIN
  81.         UDX = XMAX - XMIN
  82.         UY0 = YMIN
  83.         UDY = YMAX - YMIN
  84. C
  85. C       ********** DRAW Y AXES **********
  86. C
  87.         CALL GSSETC(CYSIZE,0.0)
  88. CCC     LOGT = .FALSE.
  89. CCC     IF (.NOT. LOGYY .OR. YTICK .NE. 1.0) GO TO 90
  90. CCC     CALL SCALE(XMIN,YMIN,VX,TEMP)
  91. CCC     CALL SCALE(XMIN,YMIN+1.0-ZLOG(8),VX,VY)
  92. CCC     IF ((VY-TEMP) .GE. TMINLD) LOGT = .TRUE.
  93. CCC90   CONTINUE
  94. C
  95. C       DRAW Y AXIS LINE
  96. C
  97.         MXLAB = 3
  98.         TENEXP = 10.0**IYPWR
  99.         X = XMIN
  100. C       TICK SPACING
  101.         TICKSP = AMAX1(0.0,TICKLN)
  102. CCCC    IF (IAND(IAXES,64) .NE. 0) YVLEN = YVLEN - TICKSP
  103. C       TICKS TO LEFT FOR LEFT Y AXIS
  104.         TCKSGN = -TICKLN
  105. 100     CONTINUE
  106.         CALL SCALE(X,YMAX,VX,VY)
  107.         CALL GSMOVE(VX,VY)
  108.         CALL SCALE(X,YMIN,VX,VY)
  109.         CALL GSDRAW(VX,VY)
  110. C
  111. C       DRAW AND LABEL Y AXIS TICKS
  112. C
  113.         Y = YTMIN
  114.         N = (YTMAX-YTMIN)/YTICK + 1.1
  115. 110     CONTINUE
  116.         CALL SCALE(X,Y*TENEXP,VX,VY)
  117.         CALL GSMOVE(VX,VY)
  118.         CALL GSDRAW(VX+TCKSGN,VY)
  119. CCCC    IF (X .EQ. XMAX) GO TO 185
  120.         IF (IAND(IAXES,1024) .NE. 0) GO TO 183
  121. C
  122. C       PLACE THE APPROPIATE LABEL
  123. C
  124. CCC     IF (LOGYY) GO TO 160
  125.         CALL LINLAB(INT(Y),IYPWR,NUMBR,LRMTEX)
  126. CCC     GO TO 180
  127. CCC160  CALL LOGLAB(INT(Y),NUMBR)
  128. 180     LN = LEN(NUMBR)
  129.         MXLAB = MAX0(MXLAB,LN)
  130.         CALL GSMOVE(VX-TICKSP-CXSIZE*(LN+0.25),VY-CYSIZE/2.0)
  131.         CALL GSPSTR(NUMBR)
  132. C
  133. C       ADD GRID LINE AT TICK IF DESIRED
  134. C
  135. 183     CONTINUE
  136. CC      IF (IAND(IAXES,8) .EQ. 0) GO TO 185
  137. CC      CALL GSLTYP(3)
  138. CC      CALL GSMOVE(VX,VY)
  139. CC      CALL SCALE(XMAX,Y*TENEXP,VX,VY)
  140. CC      CALL GSDRAW(VX,VY)
  141. CC      CALL GSLTYP(1)
  142. 185     CONTINUE
  143. C
  144. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  145. C
  146. CCC     IF ((.NOT. LOGT) .OR. (Y .EQ. YTMAX)) GO TO 200
  147. CCC     DO 190 J = 1, 8
  148. CCC     CALL SCALE(X,Y+ZLOG(J),VX,VY)
  149. CCC     CALL GSMOVE(VX,VY)
  150. CCC190  CALL GSDRAW(VX+TCKSGN/SHORTF,VY)
  151. 200     CONTINUE
  152.         Y = Y + YTICK
  153.         N = N-1
  154.         IF (N .GT. 0) GO TO 110
  155. CCCC    IF (X .EQ. XMAX) GO TO 300
  156. C
  157. C       IF LINEAR AXIS, PLACE REMOTE EXPONENT IF NEEDED
  158. C
  159. CCC     IF (LOGYY .OR. (.NOT. LRMTEX)) GO TO 260
  160. C       !!!INSTEAD OF PREVIOUS LINE
  161.         IF (.NOT. LRMTEX) GO TO 260
  162. C
  163.         IF (IAND(IAXES,1024) .NE. 0) GO TO 260
  164.         CALL SCALE(XMIN,(YTMIN+YTICK/2.0)*TENEXP,VX,VY)
  165.         CALL SCOPY('E',NUMBR)
  166.         CALL NUMSTR(IYPWR,NUMBR(2))
  167.         CALL GSMOVE(VX-CXSIZE*(LEN(NUMBR)+0.5),VY-CYSIZE/2.0)
  168.         CALL GSPSTR(NUMBR)
  169. C
  170. C       NOW PLACE Y LABLE
  171. C
  172. 260     CALL SCALE(XMIN,(YMIN+YMAX)/2.0,VX,VY)
  173.         CALL GSMOVE(VX-(MXLAB+0.25)*CXSIZE-TICKSP-CYSIZE,
  174.      1   VY-CXSIZE*LEN(YLAB)/2.0)
  175.         CALL GSSETC(CYSIZE,90.0)
  176.         CALL GSPSTR(YLAB)
  177.         CALL GSSETC(CYSIZE,0.0)
  178. CCCC    IF (IAND(IAXES,128) .EQ. 0) GO TO 300
  179. CCCC    X = XMAX
  180. CCCC    TCKSGN = TICKLN
  181. CCCC    GO TO 100
  182. 300     CONTINUE
  183. C
  184. C       ********** DRAW X AXIS **********
  185. C
  186. CCC     LOGT = .FALSE.
  187. CCC     IF (.NOT. LOGXX .OR. XTICK .NE. 1.0) GO TO 310
  188. CCC     CALL SCALE(XMIN,YMIN,TEMP,VY)
  189. CCC     CALL SCALE(XMIN+1.0-ZLOG(8),YMIN,VX,VY)
  190. CCC     IF ((VX-TEMP) .GE. TMINLD) LOGT = .TRUE.
  191. CCC310  CONTINUE
  192. C
  193. C       DRAW X AXIS LINE
  194. C
  195.         Y = YMIN
  196.         TCKSGN = -TICKLN
  197.         TENEXP = 10.0**IXPWR
  198. C       TICK SPACING
  199.         TICKSP = AMAX1(0.5*CYSIZE,TICKLN)
  200. 320     CONTINUE
  201.         CALL SCALE(XMIN,Y,VX,VY)
  202.         CALL GSMOVE(VX,VY)
  203.         CALL SCALE(XMAX,Y,VX,VY)
  204.         CALL GSDRAW(VX,VY)
  205. C
  206. C       DRAW AND LABEL X AXIS TICKS
  207. C
  208.         X = XTMIN
  209.         N = (XTMAX-XTMIN)/XTICK + 1.1
  210. 400     CONTINUE
  211.         CALL SCALE(X*TENEXP,Y,VX,VY)
  212.         CALL GSMOVE(VX,VY)
  213.         CALL GSDRAW(VX,VY+TCKSGN)
  214. CCCC    IF (Y .EQ. YMAX) GO TO 430
  215.         IF (IAND(IAXES,512) .NE. 0) GO TO 423
  216. CCC     IF (LOGXX) GO TO 410
  217.         CALL LINLAB(INT(X),IXPWR,NUMBR,LRMTEX)
  218. CCC     GO TO 420
  219. CCC410  CALL LOGLAB(INT(X),NUMBR)
  220. 420     CALL GSMOVE(VX-CXSIZE*LEN(NUMBR)/2.0,VY-TICKSP-1.5*CYSIZE)
  221.         CALL GSPSTR(NUMBR)
  222. C
  223. C       ADD GRID LINE AT TICK IF DESIRED
  224. C
  225. 423     CONTINUE
  226. CC      IF (IAND(IAXES,4) .EQ. 0) GO TO 430
  227. CC      CALL GSLTYP(3)
  228. CC      CALL GSMOVE(VX,VY)
  229. CC      CALL SCALE(X*TENEXP,YMAX,VX,VY)
  230. CC      CALL GSDRAW(VX,VY)
  231. CC      CALL GSLTYP(1)
  232. CC430   CONTINUE
  233. C
  234. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  235. C
  236. CCC     IF ((.NOT. LOGT) .OR. (X .EQ. XTMAX)) GO TO 490
  237. CCC     DO 450 J = 1, 8
  238. CCC     CALL SCALE(X+ZLOG(J),Y,VX,VY)
  239. CCC     CALL GSMOVE(VX,VY)
  240. CCC     CALL GSDRAW(VX,VY+TCKSGN/SHORTF)
  241. CCC450  CONTINUE
  242. CCC490  CONTINUE
  243.         X = X + XTICK
  244.         N = N-1
  245.         IF (N .GT. 0) GO TO 400
  246. CCCC    IF (Y .EQ. YMAX) GO TO 590
  247. C
  248. C       NOW PLACE REMOTE EXPONENT IF NEEDED ON LINEAR AXIS
  249. C
  250. CCC     IF (LOGXX .OR. (.NOT. LRMTEX)) GO TO 520
  251. C       !!!INSTEAD OF PREVIOUS LINE
  252.         IF (.NOT. LRMTEX) GO TO 520
  253. C
  254.         IF (IAND(IAXES,512) .NE. 0) GO TO 520
  255.         CALL SCALE(XMIN,YMIN,VX,VY)
  256.         CALL SCOPY('E',NUMBR)
  257.         CALL NUMSTR(IXPWR,NUMBR(2))
  258.         CALL GSMOVE(VX+3*CXSIZE,VY-TICKSP-2.75*CYSIZE)
  259.         CALL GSPSTR(NUMBR)
  260. C
  261. C       NOW PLACE X AXIS LABLE
  262. C
  263. 520     CALL SCALE((XMIN+XMAX)/2.0,YMIN,VX,VY)
  264.         CALL GSMOVE(VX-CXSIZE*LEN(XLAB)/2.0,VY-TICKSP-4.0*CYSIZE)
  265.         CALL GSPSTR(XLAB)
  266. CCCC    IF (IAND(IAXES,64) .EQ. 0) GO TO 590
  267. CCCC    Y = YMAX
  268. CCCC    TCKSGN = TICKLN
  269. CCCC    GO TO 320
  270. CCCC590 CONTINUE
  271. C
  272. C       ********** PLACE TITLE **********
  273. C
  274.         CALL SCALE((XMIN+XMAX)/2.0,YMAX,VX,VY)
  275.         TCKSGN = 0.0
  276. CCCC    IF (IAND(IAXES,64) .NE. 0) TCKSGN = TICKSP
  277.         CALL GSMOVE(VX-CXSIZE*LEN(TITLE)/2.0,VY+TCKSGN+CYSIZE)
  278.         CALL GSPSTR(TITLE)
  279. C
  280. C       MAKE SURE "PLTCLP" CONTAINS LIMITS PICKED BY MAPIT.   ONLY MAINTAINED
  281. C       FOR CALLERS INFO.
  282. C
  283. CCC     IF (.NOT. LOGXX) GO TO 610
  284. CCC             XMIN = 10.0**XMIN
  285. CCC             XMAX = 10.0**XMAX
  286. CCC610  CONTINUE
  287. CCC     IF (.NOT. LOGYY) GO TO 620
  288. CCC             YMIN = 10.0**YMIN
  289. CCC             YMAX = 10.0**YMAX
  290. CCC620  CONTINUE
  291. C
  292. C       TELL SCALE ABOUT LOG AXIS SCALING NOW
  293. C
  294. CCC     LOGX = LOGXX
  295. CCC     LOGY = LOGYY
  296.         RETURN
  297.         END
  298.